home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / external / sharelib / ftn_only_ibm.f < prev    next >
Encoding:
Text File  |  1997-07-08  |  5.8 KB  |  219 lines
  1. C
  2. C    $Id: ftn_only_ibm.f,v 1.1 1993/11/16 23:36:16 idl Exp $
  3. C
  4. C NAME:
  5. C     ftn_only
  6. C
  7. C PURPOSE:
  8. C    This Fortran function is used to demonstrate how IDL can
  9. C    pass variables to a Fortran routine and then recieve these
  10. C    variables once they are modified. 
  11. C
  12. C CATEGORY:
  13. C    Dynamic Link
  14. C
  15. C CALLING SEQUENCE:
  16. C      This function is called in IDL by using the following command
  17. C      Access to this function is achived via a C 'wrapper' function.
  18. C    
  19. C      IDL> result = CALL_EXTERNAL('ftn_only.so', 'ftn_only',    $
  20. C      IDL>      bytevar, shortvar, longvar, floatvar, doublevar,  $
  21. C      IDL>      floatarr, n_elments(floatarr) ) 
  22. C
  23. C INPUTS:
  24. C
  25. C      Byte_var:       A scalar byte variable
  26. C
  27. C      Short_var:      A scalar short integer variable
  28. C
  29. C      Long_var:       A scalar long integer variable
  30. C
  31. C      Float_var:      A scalar float variable
  32. C
  33. C      Double_var:     A scalar float variable
  34. C
  35. C      floatarr:       A floating point array
  36. C      
  37. C      cnt:           Number of elements in the array.
  38. C
  39. C OUTPUTS:
  40. C    The value of each variable is squared and the sum of the 
  41. C    array is returned as the value of the function. 
  42. C
  43. C SIDE EFFECTS:
  44. C    The values of the passed in variables are written to stdout    
  45. C
  46. C RESTRICTIONS:
  47. C    This example is setup to run using the IBM operating system.
  48. C
  49. C EXAMPLE:
  50. C-----------------------------------------------------------------------------
  51. C;; The following are the commands that would be used to call this
  52. C;; routine in IDL. This calls the C function that calls this FORTRAN
  53. C;; Subprogram.
  54. C;;
  55. C        byte_var        = 1b
  56. C        short_var       = 2
  57. C        long_var        = 3l
  58. C        float_var       = 4.0
  59. C        double_var      = 5d0
  60. C     floatarr     = findgen(30)*!pi
  61. C
  62. C        result = CALL_EXTERNAL('ftn_only.so', 'ftn_only',              $
  63. C                        byte_var, short_var, long_var, float_var,      $
  64. C                        double_var, floatarr, n_elments(floatarr) )
  65. C
  66. C-----------------------------------------------------------------------------
  67. C
  68. C MODIFICATION HISTORY:
  69. C    Written October, 1993        KDB
  70. C
  71. C     Declare the Fortran function that is called by IDL via the 
  72. C    CALL_EXTERNAL Function.
  73. C
  74. C=============================================================================
  75. C$Function FTN_ONLY
  76.  
  77.         REAL*8 FUNCTION FTN_ONLY(ARGC, ARGV)
  78.  
  79. C PURPOSE:
  80. C
  81. C       Example Fortran function that is called directly from IDL via
  82. C       the CALL_EXTERNAL function.
  83. C
  84. C       Declare the passed in variables
  85.  
  86.         INTEGER*4               ARGC    !Argument count
  87.         INTEGER*4               ARGV(*) !Vector of pointers to argments
  88.  
  89. C       Declare the function that will be called so that we can convert the
  90. C       IDL passed variables (ARGV) to Fortran varialbes via the parameter
  91. C       passing function %VAL().
  92.  
  93.         REAL*4                  FTN_ONLY1
  94.  
  95. C       Local variables
  96.  
  97.         INTEGER                 ARG_CNT
  98.  
  99. C       The argument count is passed in by value. Get the location of
  100. C       this value in memory (a pointer) and convert it into an
  101. C       Fortran integer.
  102.  
  103.         ARG_CNT = LOC(ARGC)
  104.  
  105. C    Insure that we got the correct number of arguments
  106.  
  107.     IF(ARG_CNT .ne. 7)THEN
  108.  
  109.        WRITE(*,*)'ftn_only: Incorrect number of arguments'
  110.        FTN_ONLY = -1.0
  111.        RETURN
  112.  
  113.     ENDIF
  114.  
  115. C       To convert the pointers to the IDL variables contained in ARGV
  116. C       we must use the Fortran function %VAL. This funcion is used
  117. C       in the argument list of a Fortran sub-program. Call the Fortran
  118. C       subroutine that will actually perform the desired operations.
  119. C       Set the return value to the value of this function.
  120.  
  121.         FTN_ONLY = FTN_ONLY1( %val(ARGV(1)), %val(ARGV(2)),
  122.      &                        %val(ARGV(3)), %val(ARGV(4)),
  123.      &                        %val(ARGV(5)), %val(ARGV(6)),
  124.      &                   %val(ARGV(7))  )
  125.  
  126. C       Thats all, return to IDL.
  127.  
  128.         RETURN
  129.  
  130.         END
  131.  
  132. C=============================================================================
  133. C$Function FTN_ONLY1
  134.  
  135.           REAL*4 FUNCTION FTN_ONLY1(BYTEVAR, SHORTVAR, LONGVAR,
  136.      &                FLOATVAR, DOUBLEVAR, FLOATARR, N)
  137.     
  138.         BYTE                    BYTEVAR         !IDL byte
  139.  
  140.         INTEGER*2               SHORTVAR        !IDL integer
  141.  
  142.         INTEGER*4               LONGVAR         !IDL long integer
  143.     INTEGER*4        N        !Size of array
  144.  
  145.         REAL*4                  FLOATVAR        !IDL float
  146.     REAL*4            FLOATARR(N)    !IDL float array
  147.     
  148.         DOUBLE PRECISION        DOUBLEVAR       !IDL double
  149.  
  150. C    Local Variable
  151.  
  152.     INTEGER            I        !Counter
  153.     
  154.     REAL*4            SUM        
  155.  
  156. C       Write the values of the variables that were passed in to
  157. C       Fortran from IDL.
  158.  
  159.         WRITE(*,10)
  160.  10     FORMAT(1X,/,52('-') )
  161.  
  162.         WRITE(*,20)
  163.  20     FORMAT(1X,'Inside Fortran function ftn_only ',
  164.      &            '(Called from IDL using CALL_EXTERNAL)',/)
  165.  
  166.         WRITE(*,30)
  167.  30     FORMAT(1X,'Scalar Values Passed in From IDL:')
  168.  
  169.         WRITE(*,100)BYTEVAR
  170.  100    FORMAT(10X,'BYTE Parameter:',T50,I4)
  171.  
  172.         WRITE(*,110)SHORTVAR
  173.  110    FORMAT(10X,'SHORT Parameter:',T50,I4)
  174.  
  175.         WRITE(*,120)LONGVAR
  176.  120    FORMAT(10X,'LONG Parameter:',T50,I4)
  177.  
  178.         WRITE(*,130)FLOATVAR
  179.  130    FORMAT(10X,'FLOAT Parameter:',T50,F4.1)
  180.  
  181.         WRITE(*,140)DOUBLEVAR
  182.  140    FORMAT(10X,'Double Parameter:',T50,F4.1)
  183.  
  184.      WRITE(*,145)
  185.  145    FORMAT(10X,'Float Array:')
  186.  
  187.     WRITE(*,150)(I, FLOATARR(I), I=1, N)
  188.  150    FORMAT(15X,'Element ',I3,', Value: ',T47, F7.2)
  189.  
  190.         WRITE(*,10)     !Prints a line across the page
  191.  
  192. C       Perform a simple operation on each varable (square them).
  193.  
  194.     BYTEVAR      = BYTEVAR   * BYTEVAR
  195.         SHORTVAR  = SHORTVAR  * SHORTVAR
  196.         LONGVAR   = LONGVAR   * LONGVAR
  197.         FLOATVAR  = FLOATVAR  * FLOATVAR
  198.         DOUBLEVAR = DOUBLEVAR * DOUBLEVAR
  199.  
  200. C     Now sum the array
  201.  
  202.     SUM = 0.0
  203.  
  204.     DO I = 1, N 
  205.  
  206.        SUM = SUM + FLOATARR(I)
  207.  
  208.     ENDDO    
  209.  
  210. C    Set the function equal to the sum
  211.  
  212.         FTN_ONLY1 = SUM 
  213.  
  214. C       Thats it, return to the calling routine
  215.  
  216.         RETURN
  217.  
  218.         END
  219.